perm filename PPCODE.SAI[PNT,HE]3 blob
sn#466135 filedate 1979-08-13 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00007 ENDMK
C⊗;
ENTRY;
BEGIN "PPCODE"
DEFINE $$PRGID=TRUE, $PPCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
REQUIRE "[][]" DELIMITERS;
REDEFINE MAKEOP(OPNUM,OPNAM,OPVAL)"[]" = [,"OPNAM"];
PRESET_WITH "not valid" INTOPS;
STRING ARRAY SPCODE[0:#ALINTOPS/2];
SIMPLE STRING PROCEDURE SCODE(INTEGER I);
IF I MOD 2 = 0 AND 0≤I≤#ALINTOPS THEN RETURN(SPCODE[I/2])
ELSE RETURN(SPCODE[0]);
INTERNAL PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1));
BEGIN
! program to print out pcode from number form to pcode form;
INTEGER INDEX,INDEXF;
PROCEDURE RPRINT;
BEGIN
PRINT(" ",RFVAL(EXPR$:BODY[EE][INDEX+1],
EXPR$:BODY[EE][INDEX+2]));
INDEX←INDEX+2;
END;
! PROCEDURE LPRINT;
! PRINT(" .+ ",EXPR$:BODY[EE][INDEX←INDEX+1]-GRINCH2);
PROCEDURE OPRINT;
PRINT(" ",CVOS(EXPR$:BODY[EE][INDEX←INDEX+1]));
PROCEDURE RDPRINT;
PRINT(" .+ ",EXPR$:BODY[EE][INDEX←INDEX+1],"(D)");
PROCEDURE DPRINT;
PRINT(" ",EXPR$:BODY[EE][INDEX←INDEX+1],"(D)");
PROCEDURE NLPRINT;
PRINT(CRLF,INDEX+1,": ");
PROCEDURE NPCODE;
BEGIN
INTEGER I,J;
NLPRINT; ! start new line;
I←EXPR$:BODY[EE][INDEX←INDEX+1]/2;
J←EXPR$:BODY[EE][INDEX] MOD 2;
IF J=0 AND 1≤I≤ARRINFO(SPCODE,2)
THEN PRINT(SPCODE[I])
ELSE PRINT(EXPR$:BODY[EE][INDEX],"(D)");
IF J=0 THEN
CASE I OF
BEGIN
[XJUMP/2][XPRINT/2][XJUMPC/2][XFORCHK/2]
RDPRINT;
[XRJMP/2][XRPRINT/2][XRJMPC/2][XRFRCHK/2]
RDPRINT;
[XPUSHSCI/2]
RPRINT;
[XAFFIX/2]
BEGIN
OPRINT; OPRINT; OPRINT;
IF EXPR$:BODY[EE][INDEX] LAND '2000 THEN OPRINT;
END;
[XAGTVAL/2][XACHNGE/2][XARTVAL/2]
BEGIN OPRINT; OPRINT; END;
[XGTVAL/2][XCHNGE/2][XWHERE/2][XPUSHINTI/2][XKVAR/2]
[XGTBLK/2][XCOPY/2][XRETURN/2][XPROC/2][XREPLAC/2]
[XGATHER/2][XCHCMP][XCHTPOS][XCHTORIENT]
OPRINT;
[XRCENTER/2][XRPMOVE/2]
[XRTADRIVE/2][XRTDDRIVE/2]
BEGIN RDPRINT; OPRINT; END;
[XMVAR/2]
DO OPRINT UNTIL
EXPR$:BODY[EE][INDEX]=0;
[XAPUSHOFFSET/2]
BEGIN OPRINT;OPRINT END;
[XPUSHOFFSET/2]
OPRINT;
[XGTINT/2][XGVALS/2][XCHNGS/2]
[XPUNFIX/2] INDEX←INDEX;
[XPAFFIX/2] OPRINT;
[XPSPROUT/2]
BEGIN INTEGER I,N;
DPRINT;
N←EXPR$:BODY[EE][INDEX];
FOR I←1 STEP 1 UNTIL N DO
BEGIN NLPRINT; RDPRINT;OPRINT; END;
NLPRINT; OPRINT;
END;
ELSE INDEX←INDEX
END;
END;
INDEX←SNUM-1;INDEXF←EXPR$:#BODY[EE];
WHILE INDEX<INDEXF DO NPCODE;
NLPRINT; PRINT(CRLF);
END;
PROCEDURE PPPCODE;ppcode(null_record);
END;